home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / delphi / kolekce / d6 / rxlibsetup.exe / {app} / units / RXCALC.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-02-19  |  30.2 KB  |  1,072 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 2001,2002 SGB Software          }
  6. {         Copyright (c) 1997, 1998 Fedor Koshevnikov,   }
  7. {                        Igor Pavluk and Serge Korolev  }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11.  
  12. unit RxCalc;
  13.  
  14. interface
  15.  
  16. {$I RX.INC}
  17.  
  18. uses Windows, SysUtils, Variants,
  19.   Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Menus,
  20.   ExtCtrls, Buttons, RxCtrls, Clipbrd;
  21.  
  22. const
  23.   DefCalcPrecision = 15;
  24.  
  25. type
  26.   TRxCalcState = (csFirst, csValid, csError);
  27.   TRxCalculatorForm = class;
  28.  
  29. { TRxCalculator }
  30.  
  31.   TRxCalculator = class(TComponent)
  32.   private
  33.     FValue: Double;
  34.     FMemory: Double;
  35.     FTitle: String;
  36.     FCtl3D: Boolean;
  37.     FPrecision: Byte;
  38.     FBeepOnError: Boolean;
  39.     FHelpContext: THelpContext;
  40.     FCalc: TRxCalculatorForm;
  41.     FOnChange: TNotifyEvent;
  42.     FOnCalcKey: TKeyPressEvent;
  43.     FOnDisplayChange: TNotifyEvent;
  44.     function GetDisplay: Double;
  45.     function GetTitle: string;
  46.     procedure SetTitle(const Value: string);
  47.     function TitleStored: Boolean;
  48.   protected
  49.     procedure Change; dynamic;
  50.     procedure CalcKey(var Key: Char); dynamic;
  51.     procedure DisplayChange; dynamic;
  52.   public
  53.     constructor Create(AOwner: TComponent); override;
  54.     destructor Destroy; override;
  55.     function Execute: Boolean;
  56.     property CalcDisplay: Double read GetDisplay;
  57.     property Memory: Double read FMemory;
  58.   published
  59.     property BeepOnError: Boolean read FBeepOnError write FBeepOnError default True;
  60.     property Ctl3D: Boolean read FCtl3D write FCtl3D default True;
  61.     property HelpContext: THelpContext read FHelpContext write FHelpContext default 0;
  62.     property Precision: Byte read FPrecision write FPrecision default DefCalcPrecision;
  63.     property Title: string read GetTitle write SetTitle stored TitleStored;
  64.     property Value: Double read FValue write FValue;
  65.     property OnCalcKey: TKeyPressEvent read FOnCalcKey write FOnCalcKey;
  66.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  67.     property OnDisplayChange: TNotifyEvent read FOnDisplayChange write FOnDisplayChange;
  68.   end;
  69.  
  70. { TRxCalculatorForm }
  71.  
  72.   TRxCalculatorForm = class(TForm)
  73.   private
  74.     FMainPanel: TPanel;
  75.     FCalcPanel: TPanel;
  76.     FDisplayPanel: TPanel;
  77.     FDisplayLabel: TLabel;
  78.     FPasteItem: TMenuItem;
  79.     procedure FormKeyPress(Sender: TObject; var Key: Char);
  80.     procedure PopupMenuPopup(Sender: TObject);
  81.     procedure CopyItemClick(Sender: TObject);
  82.     procedure PasteItemClick(Sender: TObject);
  83.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  84.   protected
  85.     procedure OkClick(Sender: TObject);
  86.     procedure CancelClick(Sender: TObject);
  87.     procedure CalcKey(Sender: TObject; var Key: Char);
  88.     procedure DisplayChange(Sender: TObject);
  89.   public
  90.     constructor Create(AOwner: TComponent); override;
  91.   end;
  92.  
  93. function CreateCalculatorForm(AOwner: TComponent; AHelpContext: THelpContext): TRxCalculatorForm;
  94. function CreatePopupCalculator(AOwner: TComponent
  95.   {$IFDEF RX_D4}; ABiDiMode: TBiDiMode = bdLeftToRight {$ENDIF}): TWinControl;
  96. procedure SetupPopupCalculator(PopupCalc: TWinControl; APrecision: Byte;
  97.   ABeepOnError: Boolean);
  98.  
  99. implementation
  100.  
  101. uses {$IFNDEF WIN32} Str16, {$ENDIF} VclUtils, MaxMin, rxStrUtils, ToolEdit;
  102.  
  103. {$IFDEF WIN32}
  104.  {$R *.R32}
  105. {$ELSE}
  106.  {$R *.R16}
  107. {$ENDIF}
  108.  
  109. const
  110.   SCalculator = 'Calculator';
  111.   SError = 'Error';
  112.  
  113. type
  114.   TCalcBtnKind =
  115.    (cbNone, cbNum0, cbNum1, cbNum2, cbNum3, cbNum4, cbNum5, cbNum6,
  116.     cbNum7, cbNum8, cbNum9, cbSgn, cbDcm, cbDiv, cbMul, cbSub,
  117.     cbAdd, cbSqr, cbPcnt, cbRev, cbEql, cbBck, cbClr, cbMP,
  118.     cbMS, cbMR, cbMC, cbOk, cbCancel);
  119.  
  120.   TCalcPanelLayout = (clDialog, clPopup);
  121.  
  122. procedure SetDefaultFont(AFont: TFont; Layout: TCalcPanelLayout);
  123. {$IFDEF WIN32}
  124. var
  125.   NonClientMetrics: TNonClientMetrics;
  126. {$ENDIF}
  127. begin
  128. {$IFDEF WIN32}
  129.   NonClientMetrics.cbSize := SizeOf(NonClientMetrics);
  130.   if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0) then
  131.     AFont.Handle := CreateFontIndirect(NonClientMetrics.lfMessageFont)
  132.   else
  133. {$ENDIF}
  134.   with AFont do begin
  135.     Color := clWindowText;
  136.     Name := 'MS Sans Serif';
  137.     Size := 8;
  138.   end;
  139.   AFont.Style := [fsBold];
  140.   if Layout = clDialog then begin
  141.   end
  142.   else begin
  143.   end;
  144. end;
  145.  
  146. function CreateCalculatorForm(AOwner: TComponent; AHelpContext: THelpContext): TRxCalculatorForm;
  147. begin
  148.   Result := TRxCalculatorForm.Create(AOwner);
  149.   with Result do
  150.   try
  151.     HelpContext := AHelpContext;
  152. {$IFDEF WIN32}
  153.     if HelpContext <> 0 then BorderIcons := BorderIcons + [biHelp];
  154. {$ENDIF}
  155.     if Screen.PixelsPerInch <> 96 then begin { scale to screen res }
  156.       ScaleBy(Screen.PixelsPerInch, 96);
  157.       SetDefaultFont(Font, clDialog);
  158.       Left := (Screen.Width div 2) - (Width div 2);
  159.       Top := (Screen.Height div 2) - (Height div 2);
  160.     end;
  161.   except
  162.     Free;
  163.     raise;
  164.   end;
  165. end;
  166.  
  167. { TCalcButton }
  168.  
  169. type
  170.   TCalcButton = class(TRxSpeedButton)
  171.   private
  172.     FKind: TCalcBtnKind;
  173.     FFontChanging: Boolean;
  174.   protected
  175.     procedure CMParentFontChanged(var Message: TMessage); message CM_PARENTFONTCHANGED;
  176.   public
  177.     constructor CreateKind(AOwner: TComponent; AKind: TCalcBtnKind);
  178.     property Kind: TCalcBtnKind read FKind;
  179.   end;
  180.  
  181. constructor TCalcButton.CreateKind(AOwner: TComponent; AKind: TCalcBtnKind);
  182. begin
  183.   inherited Create(AOwner);
  184. {$IFDEF WIN32}
  185.   ControlStyle := ControlStyle + [csReplicatable];
  186. {$ENDIF}
  187.   FKind := AKind;
  188.   if FKind in [cbNum0..cbClr] then Tag := Ord(Kind) - 1
  189.   else Tag := -1;
  190. end;
  191.  
  192. procedure TCalcButton.CMParentFontChanged(var Message: TMessage);
  193.  
  194.   function BtnColor(Kind: TCalcBtnKind): TColor;
  195.   begin
  196.     if Kind in [cbSqr, cbPcnt, cbRev, cbMP..cbMC] then Result := clNavy
  197.     else if Kind in [cbDiv, cbMul, cbSub, cbAdd, cbEql] then Result := clPurple
  198.     else if Kind in [cbBck, cbClr] then Result := clMaroon
  199.     else Result := clBtnText;
  200.   end;
  201.  
  202. begin
  203.   if not FFontChanging then inherited;
  204.   if ParentFont and not FFontChanging then begin
  205.     FFontChanging := True;
  206.     try
  207.       Font.Color := BtnColor(FKind);
  208.       ParentFont := True;
  209.     finally
  210.       FFontChanging := False;
  211.     end;
  212.   end;
  213. end;
  214.  
  215. const
  216.   BtnPos: array[TCalcPanelLayout, TCalcBtnKind] of TPoint =
  217.   (((X: -1; Y: -1), (X: 47; Y: 104), (X: 47; Y: 80), (X: 85; Y: 80),
  218.     (X: 123; Y: 80), (X: 47; Y: 56), (X: 85; Y: 56), (X: 123; Y: 56),
  219.     (X: 47; Y: 32), (X: 85; Y: 32), (X: 123; Y: 32), (X: 85; Y: 104),
  220.     (X: 123; Y: 104), (X: 161; Y: 32), (X: 161; Y: 56), (X: 161; Y: 80),
  221.     (X: 161; Y: 104), (X: 199; Y: 32), (X: 199; Y: 56), (X: 199; Y: 80),
  222.     (X: 199; Y: 104), (X: 145; Y: 6), (X: 191; Y: 6), (X: 5; Y: 104),
  223.     (X: 5; Y: 80), (X: 5; Y: 56), (X: 5; Y: 32),
  224.     (X: 47; Y: 6), (X: 85; Y: 6)),
  225.    ((X: -1; Y: -1), (X: 6; Y: 75), (X: 6; Y: 52), (X: 29; Y: 52),
  226.     (X: 52; Y: 52), (X: 6; Y: 29), (X: 29; Y: 29), (X: 52; Y: 29),
  227.     (X: 6; Y: 6), (X: 29; Y: 6), (X: 52; Y: 6), (X: 52; Y: 75),
  228.     (X: 29; Y: 75), (X: 75; Y: 6), (X: 75; Y: 29), (X: 75; Y: 52),
  229.     (X: 75; Y: 75), (X: -1; Y: -1), (X: -1; Y: -1), (X: -1; Y: -1),
  230.     (X: 52; Y: 98), (X: 29; Y: 98), (X: 6; Y: 98), (X: -1; Y: -1),
  231.     (X: -1; Y: -1), (X: -1; Y: -1), (X: -1; Y: -1),
  232.     (X: -1; Y: -1), (X: -1; Y: -1)));
  233.  
  234.   ResultKeys = [#13, '=', '%'];
  235.  
  236. function CreateCalcBtn(AParent: TWinControl; AKind: TCalcBtnKind;
  237.   AOnClick: TNotifyEvent; ALayout: TCalcPanelLayout): TCalcButton;
  238. const
  239.   BtnCaptions: array[cbSgn..cbMC] of PChar =
  240.    ('▒', ',', '/', '*', '-', '+', 'sqrt', '%', '1/x', '=', '<-', 'C',
  241.     'MP', 'MS', 'MR', 'MC');
  242. begin
  243.   Result := TCalcButton.CreateKind(AParent, AKind);
  244.   with Result do
  245.   try
  246.     if Kind in [cbNum0..cbNum9] then Caption := IntToStr(Tag)
  247.     else if Kind = cbDcm then Caption := DecimalSeparator
  248.     else if Kind in [cbSgn..cbMC] then Caption := StrPas(BtnCaptions[Kind]);
  249.     Left := BtnPos[ALayout, Kind].X;
  250.     Top := BtnPos[ALayout, Kind].Y;
  251.     if ALayout = clDialog then begin
  252.       Width := 36;
  253.       Height := 22;
  254.     end
  255.     else begin
  256.       Width := 21;
  257.       Height := 21;
  258.     end;
  259.     Style := bsNew;
  260.     OnClick := AOnClick;
  261.     ParentFont := True;
  262.     Parent := AParent;
  263.   except
  264.     Free;
  265.     raise;
  266.   end;
  267. end;
  268.  
  269. { TCalculatorPanel }
  270.  
  271. type
  272.   TCalculatorPanel = class(TPanel)
  273.   private
  274.     FText: string;
  275.     FStatus: TRxCalcState;
  276.     FOperator: Char;
  277.     FOperand: Double;
  278.     FMemory: Double;
  279.     FPrecision: Byte;
  280.     FBeepOnError: Boolean;
  281.     FMemoryPanel: TPanel;
  282.     FMemoryLabel: TLabel;
  283.     FOnError: TNotifyEvent;
  284.     FOnOk: TNotifyEvent;
  285.     FOnCancel: TNotifyEvent;
  286.     FOnResult: TNotifyEvent;
  287.     FOnTextChange: TNotifyEvent;
  288.     FOnCalcKey: TKeyPressEvent;
  289.     FOnDisplayChange: TNotifyEvent;
  290.     FControl: TControl;
  291.     procedure SetText(const Value: string);
  292.     procedure CheckFirst;
  293.     procedure CalcKey(Key: Char);
  294.     procedure Clear;
  295.     procedure Error;
  296.     procedure SetDisplay(R: Double);
  297.     function GetDisplay: Double;
  298.     procedure UpdateMemoryLabel;
  299.     function FindButton(Key: Char): TRxSpeedButton;
  300.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  301.     procedure BtnClick(Sender: TObject);
  302.   protected
  303.     procedure TextChanged; virtual;
  304.   public
  305.     constructor CreateLayout(AOwner: TComponent; ALayout: TCalcPanelLayout);
  306.     procedure CalcKeyPress(Sender: TObject; var Key: Char);
  307.     procedure Copy;
  308.     procedure Paste;
  309.     property DisplayValue: Double read GetDisplay write SetDisplay;
  310.     property Text: string read FText;
  311.     property OnOkClick: TNotifyEvent read FOnOk write FOnOk;
  312.     property OnCancelClick: TNotifyEvent read FOnCancel write FOnCancel;
  313.     property OnResultClick: TNotifyEvent read FOnResult write FOnResult;
  314.     property OnError: TNotifyEvent read FOnError write FOnError;
  315.     property OnTextChange: TNotifyEvent read FOnTextChange write FOnTextChange;
  316.     property OnCalcKey: TKeyPressEvent read FOnCalcKey write FOnCalcKey;
  317.     property OnDisplayChange: TNotifyEvent read FOnDisplayChange write FOnDisplayChange;
  318.   end;
  319.  
  320. constructor TCalculatorPanel.CreateLayout(AOwner: TComponent;
  321.   ALayout: TCalcPanelLayout);
  322. var
  323.   Bmp: TBitmap;
  324.   I: TCalcBtnKind;
  325. const
  326.   BtnGlyphs: array[cbSgn..cbCancel] of Integer = (2{Sgn}, -1, -1, 3{Mul},
  327.     4{Sub}, 5{Add}, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 1{Ok}, 0{Cancel});
  328. begin
  329.   inherited Create(AOwner);
  330. {$IFDEF WIN32}
  331.   if ALayout = clPopup then
  332.     ControlStyle := ControlStyle + [csReplicatable];
  333. {$ENDIF}
  334.   ParentColor := False;
  335.   Color := clBtnFace;
  336.   if ALayout = clDialog then begin
  337.     Height := 129;
  338.     Width := 240;
  339.   end
  340.   else begin
  341.     Height := 124;
  342.     Width := 98;
  343.   end;
  344.   SetDefaultFont(Font, ALayout);
  345.   ParentFont := False;
  346.   BevelOuter := bvNone;
  347.   BevelInner := bvNone;
  348.   ParentColor := True;
  349.   ParentCtl3D := True;
  350.   if ALayout = clDialog then Bmp := TBitmap.Create
  351.   else Bmp := nil;
  352.   try
  353.     if Bmp <> nil then Bmp.Handle := LoadBitmap(hInstance, 'CALCBTNS');
  354.     for I := cbNum0 to cbCancel do begin
  355.       if BtnPos[ALayout, I].X > 0 then
  356.         with CreateCalcBtn(Self, I, BtnClick, ALayout) do begin
  357.           if ALayout = clDialog then begin
  358.             if (Kind in [cbBck, cbClr]) then Width := 44;
  359.             if (Kind in [cbSgn..cbCancel]) then
  360.               if BtnGlyphs[Kind] >= 0 then begin
  361.                 Caption := '';
  362.                 AssignBitmapCell(Bmp, Glyph, 6, 1, BtnGlyphs[Kind]);
  363.               end;
  364.           end
  365.           else begin
  366.             if Kind in [cbEql] then Width := 44;
  367.           end;
  368.         end;
  369.     end;
  370.     if ALayout = clDialog then begin
  371.       { Memory panel }
  372.       FMemoryPanel := TPanel.Create(Self);
  373.       with FMemoryPanel do begin
  374.         SetBounds(6, 7, 34, 20);
  375.         BevelInner := bvLowered;
  376.         BevelOuter := bvNone;
  377.         ParentColor := True;
  378.         Parent := Self;
  379.       end;
  380.       FMemoryLabel := TLabel.Create(Self);
  381.       with FMemoryLabel do begin
  382.         SetBounds(3, 3, 26, 14);
  383.         Alignment := taCenter;
  384.         AutoSize := False;
  385.         Parent := FMemoryPanel;
  386.         Font.Style := [];
  387.       end;
  388.     end;
  389.   finally
  390.     Bmp.Free;
  391.   end;
  392.   FText := '0';
  393.   FMemory := 0.0;
  394.   FPrecision := DefCalcPrecision;
  395.   FBeepOnError := True;
  396. end;
  397.  
  398. procedure TCalculatorPanel.SetText(const Value: string);
  399. begin
  400.   if FText <> Value then begin
  401.     FText := Value;
  402.     TextChanged;
  403.   end;
  404. end;
  405.  
  406. procedure TCalculatorPanel.TextChanged;
  407. begin
  408.   if Assigned(FControl) then TLabel(FControl).Caption := FText;
  409.   if Assigned(FOnTextChange) then FOnTextChange(Self);
  410. end;
  411.  
  412. procedure TCalculatorPanel.Error;
  413. begin
  414.   FStatus := csError;
  415.   SetText(SError);
  416.   if FBeepOnError then MessageBeep(0);
  417.   if Assigned(FOnError) then FOnError(Self);
  418. end;
  419.  
  420. procedure TCalculatorPanel.SetDisplay(R: Double);
  421. var
  422.   S: string;
  423. begin
  424.   S := FloatToStrF(R, ffGeneral, Max(2, FPrecision), 0);
  425.   if FText <> S then begin
  426.     SetText(S);
  427.     if Assigned(FOnDisplayChange) then FOnDisplayChange(Self);
  428.   end;
  429. end;
  430.  
  431. function TCalculatorPanel.GetDisplay: Double;
  432. begin
  433.   if FStatus = csError then Result := 0.0
  434.   else Result := StrToFloat(Trim(FText));
  435. end;
  436.  
  437. procedure TCalculatorPanel.CheckFirst;
  438. begin
  439.   if FStatus = csFirst then begin
  440.     FStatus := csValid;
  441.     SetText('0');
  442.   end;
  443. end;
  444.  
  445. procedure TCalculatorPanel.CMCtl3DChanged(var Message: TMessage);
  446. const
  447.   Ctl3DStyle: array[Boolean] of TButtonStyle = (bsWin31, bsNew);
  448.   Ctl3DBevel: array[Boolean] of TPanelBevel = (bvNone, bvLowered);
  449.   Ctl3DBorder: array[Boolean] of TBorderStyle = (bsSingle, bsNone);
  450. var
  451.   I: Integer;
  452. begin
  453.   inherited;
  454.   for I := 0 to ComponentCount - 1 do begin
  455.     if Components[I] is TRxSpeedButton then
  456.       TRxSpeedButton(Components[I]).Style := Ctl3DStyle[Ctl3D]
  457.     else if Components[I] = FMemoryPanel then begin
  458.       FMemoryPanel.BevelInner := Ctl3DBevel[Ctl3D];
  459.       FMemoryPanel.BorderStyle := Ctl3DBorder[Ctl3D];
  460.     end;
  461.   end;
  462. end;
  463.  
  464. procedure TCalculatorPanel.UpdateMemoryLabel;
  465. begin
  466.   if FMemoryLabel <> nil then
  467.     if FMemory <> 0.0 then FMemoryLabel.Caption := 'M'
  468.     else FMemoryLabel.Caption := '';
  469. end;
  470.  
  471. procedure TCalculatorPanel.CalcKey(Key: Char);
  472. var
  473.   R: Double;
  474. begin
  475.   Key := UpCase(Key);
  476.   if (FStatus = csError) and (Key <> 'C') then Key := #0;
  477.   if Assigned(FOnCalcKey) then FOnCalcKey(Self, Key);
  478.   if Key in [DecimalSeparator, '.', ','] then begin
  479.     CheckFirst;
  480.     if Pos(DecimalSeparator, FText) = 0 then
  481.       SetText(FText + DecimalSeparator);
  482.     Exit;
  483.   end;
  484.   case Key of
  485.     'R':
  486.       if FStatus in [csValid, csFirst] then begin
  487.         FStatus := csFirst;
  488.         if GetDisplay = 0 then Error else SetDisplay(1.0 / GetDisplay);
  489.       end;
  490.     'Q':
  491.       if FStatus in [csValid, csFirst] then begin
  492.         FStatus := csFirst;
  493.         if GetDisplay < 0 then Error else SetDisplay(Sqrt(GetDisplay));
  494.       end;
  495.     '0'..'9':
  496.       begin
  497.         CheckFirst;
  498.         if FText = '0' then SetText('');
  499.         if Pos('E', FText) = 0 then begin
  500.           if Length(FText) < Max(2, FPrecision) + Ord(Boolean(Pos('-', FText))) then
  501.             SetText(FText + Key)
  502.           else if FBeepOnError then MessageBeep(0);
  503.         end;
  504.       end;
  505.     #8:
  506.       begin
  507.         CheckFirst;
  508.         if (Length(FText) = 1) or ((Length(FText) = 2) and (FText[1] = '-')) then
  509.           SetText('0')
  510.         else
  511.           SetText(System.Copy(FText, 1, Length(FText) - 1));
  512.       end;
  513.     '_': SetDisplay(-GetDisplay);
  514.     '+', '-', '*', '/', '=', '%', #13:
  515.       begin
  516.         if FStatus = csValid then begin
  517.           FStatus := csFirst;
  518.           R := GetDisplay;
  519.           if Key = '%' then
  520.             case FOperator of
  521.               '+', '-': R := FOperand * R / 100.0;
  522.               '*', '/': R := R / 100.0;
  523.             end;
  524.           case FOperator of
  525.             '+': SetDisplay(FOperand + R);
  526.             '-': SetDisplay(FOperand - R);
  527.             '*': SetDisplay(FOperand * R);
  528.             '/': if R = 0 then Error else SetDisplay(FOperand / R);
  529.           end;
  530.         end;
  531.         FOperator := Key;
  532.         FOperand := GetDisplay;
  533.         if Key in ResultKeys then
  534.           if Assigned(FOnResult) then FOnResult(Self);
  535.       end;
  536.     #27, 'C': Clear;
  537.     ^C: Copy;
  538.     ^V: Paste;
  539.   end;
  540. end;
  541.  
  542. procedure TCalculatorPanel.Clear;
  543. begin
  544.   FStatus := csFirst;
  545.   SetDisplay(0.0);
  546.   FOperator := '=';
  547. end;
  548.  
  549. procedure TCalculatorPanel.CalcKeyPress(Sender: TObject; var Key: Char);
  550. var
  551.   Btn: TRxSpeedButton;
  552. begin
  553.   Btn := FindButton(Key);
  554.   if Btn <> nil then Btn.ButtonClick
  555.   else CalcKey(Key);
  556. end;
  557.  
  558. function TCalculatorPanel.FindButton(Key: Char): TRxSpeedButton;
  559. const
  560.   ButtonChars = '0123456789_./*-+Q%R='#8'C';
  561. var
  562.   I: Integer;
  563.   BtnTag: Longint;
  564. begin
  565.   if Key in [DecimalSeparator, '.', ','] then Key := '.'
  566.   else if Key = #13 then Key := '='
  567.   else if Key = #27 then Key := 'C';
  568.   BtnTag := Pos(UpCase(Key), ButtonChars) - 1;
  569.   if BtnTag >= 0 then
  570.     for I := 0 to ControlCount - 1 do begin
  571.       if Controls[I] is TRxSpeedButton then begin
  572.         Result := TRxSpeedButton(Controls[I]);
  573.         if Result.Tag = BtnTag then Exit;
  574.       end;
  575.     end;
  576.   Result := nil;
  577. end;
  578.  
  579. procedure TCalculatorPanel.BtnClick(Sender: TObject);
  580. begin
  581.   case TCalcButton(Sender).Kind of
  582.     cbNum0..cbNum9: CalcKey(Char(TComponent(Sender).Tag + Ord('0')));
  583.     cbSgn: CalcKey('_');
  584.     cbDcm: CalcKey(DecimalSeparator);
  585.     cbDiv: CalcKey('/');
  586.     cbMul: CalcKey('*');
  587.     cbSub: CalcKey('-');
  588.     cbAdd: CalcKey('+');
  589.     cbSqr: CalcKey('Q');
  590.     cbPcnt: CalcKey('%');
  591.     cbRev: CalcKey('R');
  592.     cbEql: CalcKey('=');
  593.     cbBck: CalcKey(#8);
  594.     cbClr: CalcKey('C');
  595.     cbMP:
  596.       if FStatus in [csValid, csFirst] then begin
  597.         FStatus := csFirst;
  598.         FMemory := FMemory + GetDisplay;
  599.         UpdateMemoryLabel;
  600.       end;
  601.     cbMS:
  602.       if FStatus in [csValid, csFirst] then begin
  603.         FStatus := csFirst;
  604.         FMemory := GetDisplay;
  605.         UpdateMemoryLabel;
  606.       end;
  607.     cbMR:
  608.       if FStatus in [csValid, csFirst] then begin
  609.         FStatus := csFirst;
  610.         CheckFirst;
  611.         SetDisplay(FMemory);
  612.       end;
  613.     cbMC:
  614.       begin
  615.         FMemory := 0.0;
  616.         UpdateMemoryLabel;
  617.       end;
  618.     cbOk:
  619.       begin
  620.         if FStatus <> csError then begin
  621.           DisplayValue := DisplayValue; { to raise exception on error }
  622.           if Assigned(FOnOk) then FOnOk(Self);
  623.         end
  624.         else if FBeepOnError then MessageBeep(0);
  625.       end;
  626.     cbCancel: if Assigned(FOnCancel) then FOnCancel(Self);
  627.   end;
  628. end;
  629.  
  630. procedure TCalculatorPanel.Copy;
  631. begin
  632.   Clipboard.AsText := FText;
  633. end;
  634.  
  635. procedure TCalculatorPanel.Paste;
  636. begin
  637.   if Clipboard.HasFormat(CF_TEXT) then
  638.     try
  639.       SetDisplay(StrToFloat(Trim(ReplaceStr(Clipboard.AsText,
  640.         CurrencyString, ''))));
  641.     except
  642.       SetText('0');
  643.     end;
  644. end;
  645.  
  646. { TLocCalculator }
  647.  
  648. type
  649.   TLocCalculator = class(TCalculatorPanel)
  650.   private
  651.     procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
  652.   protected
  653.     procedure CreateParams(var Params: TCreateParams); override;
  654.   public
  655.     constructor Create(AOwner: TComponent); override;
  656.   end;
  657.  
  658. constructor TLocCalculator.Create(AOwner: TComponent);
  659. begin
  660.   inherited CreateLayout(AOwner, clPopup);
  661.   ControlStyle := [csCaptureMouse, csClickEvents, csDoubleClicks];
  662. {$IFDEF WIN32}
  663.   ControlStyle := ControlStyle + [csReplicatable];
  664. {$ENDIF}
  665.   Enabled := False;
  666.   TabStop := False;
  667. end;
  668.  
  669. procedure TLocCalculator.CMEnabledChanged(var Message: TMessage);
  670. begin
  671.   if HandleAllocated and not (csDesigning in ComponentState) then
  672.     EnableWindow(Handle, True);
  673. end;
  674.  
  675. procedure TLocCalculator.CreateParams(var Params: TCreateParams);
  676. begin
  677.   inherited CreateParams(Params);
  678.   with Params do begin
  679.     Style := Style and not (WS_TABSTOP or WS_DISABLED);
  680. {$IFDEF RX_D4}
  681.     AddBiDiModeExStyle(ExStyle);
  682. {$ENDIF}
  683.   end;
  684. end;
  685.  
  686. { TPopupCalculator }
  687.  
  688. type
  689.   TPopupCalculator = class(TPopupWindow)
  690.   private
  691.     FCalcPanel: TLocCalculator;
  692.     procedure TextChange(Sender: TObject);
  693.     procedure ResultClick(Sender: TObject);
  694.   protected
  695.     procedure KeyPress(var Key: Char); override;
  696. {$IFDEF WIN32}
  697.     function GetValue: Variant; override;
  698.     procedure SetValue(const Value: Variant); override;
  699. {$ELSE}
  700.     function GetValue: string; override;
  701.     procedure SetValue(const Value: string); override;
  702. {$ENDIF}
  703.   public
  704.     constructor Create(AOwner: TComponent); override;
  705.     function GetPopupText: string; override;
  706.   end;
  707.  
  708. function CreatePopupCalculator(AOwner: TComponent
  709.   {$IFDEF RX_D4}; ABiDiMode: TBiDiMode = bdLeftToRight {$ENDIF}): TWinControl;
  710. begin
  711.   Result := TPopupCalculator.Create(AOwner);
  712.   if (AOwner <> nil) and not (csDesigning in AOwner.ComponentState) and
  713.     (Screen.PixelsPerInch <> 96) then
  714.   begin { scale to screen res }
  715.     Result.ScaleBy(Screen.PixelsPerInch, 96);
  716.     { The ScaleBy method does not scale the font well, so set the
  717.       font back to the original info. }
  718.     TPopupCalculator(Result).FCalcPanel.ParentFont := True;
  719.     SetDefaultFont(TPopupCalculator(Result).Font, clPopup);
  720. {$IFDEF RX_D4}
  721.     Result.BiDiMode := ABiDiMode;
  722. {$ENDIF}
  723.   end;
  724. end;
  725.  
  726. procedure SetupPopupCalculator(PopupCalc: TWinControl; APrecision: Byte;
  727.   ABeepOnError: Boolean);
  728. begin
  729.   if (PopupCalc = nil) or not (PopupCalc is TPopupCalculator) then
  730.     Exit;
  731.   if TPopupCalculator(PopupCalc).FCalcPanel <> nil then
  732.     with TPopupCalculator(PopupCalc).FCalcPanel do begin
  733.       FPrecision := Max(2, APrecision);
  734.       FBeepOnError := ABeepOnError;
  735.     end;
  736. end;
  737.  
  738. constructor TPopupCalculator.Create(AOwner: TComponent);
  739. begin
  740.   inherited Create(AOwner);
  741.   Height := 127;
  742.   Width := 104;
  743.   Color := clBtnFace;
  744.   SetDefaultFont(Font, clPopup);
  745.   if (csDesigning in ComponentState) then Exit;
  746.   FCalcPanel := TLocCalculator.Create(Self);
  747.   with FCalcPanel do begin
  748.     Parent := Self;
  749.     Align := alClient;
  750.     BevelOuter := bvRaised;
  751.     FPrecision := DefCalcPrecision;
  752.     Visible := True;
  753.     OnTextChange := Self.TextChange;
  754.     OnResultClick := Self.ResultClick;
  755.   end;
  756. end;
  757.  
  758. procedure TPopupCalculator.KeyPress(var Key: Char);
  759. begin
  760.   if FCalcPanel <> nil then FCalcPanel.CalcKeyPress(Self, Key);
  761.   inherited KeyPress(Key);
  762. end;
  763.  
  764. {$IFDEF WIN32}
  765.  
  766. function TPopupCalculator.GetValue: Variant;
  767. begin
  768.   if (csDesigning in ComponentState) then Result := 0
  769.   else begin
  770.     if FCalcPanel.FStatus <> csError then begin
  771.       { to raise exception on error }
  772.       FCalcPanel.DisplayValue := FCalcPanel.DisplayValue;
  773.       Result := FCalcPanel.DisplayValue;
  774.     end
  775.     else begin
  776.       if FCalcPanel.FBeepOnError then MessageBeep(0);
  777.       Result := 0;
  778.     end;
  779.   end;
  780. end;
  781.  
  782. procedure TPopupCalculator.SetValue(const Value: Variant);
  783. begin
  784.   if not (csDesigning in ComponentState) then
  785.     with FCalcPanel do begin
  786.       try
  787.         if VarIsNull(Value) or VarIsEmpty(Value) then
  788.           DisplayValue := 0
  789.         else
  790.           DisplayValue := Value;
  791.       except
  792.         DisplayValue := 0;
  793.       end;
  794.       FStatus := csFirst;
  795.       FOperator := '=';
  796.     end;
  797. end;
  798.  
  799. {$ELSE}
  800.  
  801. function TPopupCalculator.GetValue: string;
  802. var
  803.   D: Double;
  804. begin
  805.   if (csDesigning in ComponentState) or (FCalcPanel = nil) then Result := '0'
  806.   else begin
  807.     if FCalcPanel.FStatus <> csError then begin
  808.       { to raise exception on error }
  809.       FCalcPanel.DisplayValue := FCalcPanel.DisplayValue;
  810.       D := FCalcPanel.DisplayValue;
  811.     end
  812.     else begin
  813.       if FCalcPanel.FBeepOnError then MessageBeep(0);
  814.       D := 0;
  815.     end;
  816.     Result := FloatToStrF(D, ffGeneral, Max(2, FCalcPanel.FPrecision), 0);
  817.   end;
  818. end;
  819.  
  820. procedure TPopupCalculator.SetValue(const Value: string);
  821. begin
  822.   if not (csDesigning in ComponentState) then begin
  823.     with FCalcPanel do begin
  824.       if Value = '' then DisplayValue := 0
  825.       else
  826.         try
  827.           DisplayValue := StrToFloat(Value);
  828.         except
  829.           DisplayValue := 0;
  830.         end;
  831.       FStatus := csFirst;
  832.       FOperator := '=';
  833.     end;
  834.   end;
  835. end;
  836.  
  837. {$ENDIF}
  838.  
  839. function TPopupCalculator.GetPopupText: string;
  840. begin
  841.   Result := FCalcPanel.Text;
  842. end;
  843.  
  844. procedure TPopupCalculator.ResultClick(Sender: TObject);
  845. begin
  846.   if FCalcPanel.FStatus <> csError then begin
  847.     FCalcPanel.DisplayValue := FCalcPanel.DisplayValue;
  848.     CloseUp(True);
  849.   end;
  850. end;
  851.  
  852. procedure TPopupCalculator.TextChange(Sender: TObject);
  853. begin
  854.   InvalidateEditor;
  855. end;
  856.  
  857. { TRxCalculator }
  858.  
  859. constructor TRxCalculator.Create(AOwner: TComponent);
  860. begin
  861.   inherited Create(AOwner);
  862.   FTitle := SCalculator;
  863.   FCtl3D := True;
  864.   FPrecision := DefCalcPrecision;
  865.   FBeepOnError := True;
  866. end;
  867.  
  868. destructor TRxCalculator.Destroy;
  869. begin
  870.   FOnChange := nil;
  871.   FOnDisplayChange := nil;
  872.   inherited Destroy;
  873. end;
  874.  
  875. function TRxCalculator.GetTitle: string;
  876. begin
  877.   Result := FTitle;
  878. end;
  879.  
  880. procedure TRxCalculator.SetTitle(const Value: string);
  881. begin
  882.   FTitle := Value;
  883. end;
  884.  
  885. function TRxCalculator.TitleStored: Boolean;
  886. begin
  887.   Result := Title <> SCalculator;
  888. end;
  889.  
  890. function TRxCalculator.GetDisplay: Double;
  891. begin
  892.   if Assigned(FCalc) then
  893.     Result := TCalculatorPanel(FCalc.FCalcPanel).GetDisplay
  894.   else Result := FValue;
  895. end;
  896.  
  897. procedure TRxCalculator.CalcKey(var Key: Char);
  898. begin
  899.   if Assigned(FOnCalcKey) then FOnCalcKey(Self, Key);
  900. end;
  901.  
  902. procedure TRxCalculator.DisplayChange;
  903. begin
  904.   if Assigned(FOnDisplayChange) then FOnDisplayChange(Self);
  905. end;
  906.  
  907. procedure TRxCalculator.Change;
  908. begin
  909.   if Assigned(FOnChange) then FOnChange(Self);
  910. end;
  911.  
  912. function TRxCalculator.Execute: Boolean;
  913. begin
  914.   FCalc := CreateCalculatorForm(Self, HelpContext);
  915.   with FCalc do
  916.   try
  917.     Ctl3D := FCtl3D;
  918.     Caption := Self.Title;
  919.     TCalculatorPanel(FCalcPanel).FMemory := Self.FMemory;
  920.     TCalculatorPanel(FCalcPanel).UpdateMemoryLabel;
  921.     TCalculatorPanel(FCalcPanel).FPrecision := Max(2, Self.Precision);
  922.     TCalculatorPanel(FCalcPanel).FBeepOnError := Self.BeepOnError;
  923.     if Self.FValue <> 0 then begin
  924.       TCalculatorPanel(FCalcPanel).DisplayValue := Self.FValue;
  925.       TCalculatorPanel(FCalcPanel).FStatus := csFirst;
  926.       TCalculatorPanel(FCalcPanel).FOperator := '=';
  927.     end;
  928.     Result := (ShowModal = mrOk);
  929.     if Result then begin
  930.       Self.FMemory := TCalculatorPanel(FCalcPanel).FMemory;
  931.       if (TCalculatorPanel(FCalcPanel).DisplayValue <> Self.FValue) then begin
  932.         Self.FValue := TCalculatorPanel(FCalcPanel).DisplayValue;
  933.         Change;
  934.       end;
  935.     end;
  936.   finally
  937.     Free;
  938.     FCalc := nil;
  939.   end;
  940. end;
  941.  
  942. { TRxCalculatorForm }
  943.  
  944. constructor TRxCalculatorForm.Create(AOwner: TComponent);
  945. var
  946.   Control: TWinControl;
  947.   Popup: TPopupMenu;
  948.   Items: array[0..1] of TMenuItem;
  949. begin
  950. {$IFDEF CBUILDER}
  951.   inherited CreateNew(AOwner, 0);
  952. {$ELSE}
  953.   inherited CreateNew(AOwner);
  954. {$ENDIF}
  955.   BorderIcons := [biSystemMenu];
  956.   BorderStyle := bsDialog;
  957.   Caption := SCalculator;
  958.   ClientHeight := 159;
  959.   ClientWidth := 242;
  960.   SetDefaultFont(Font, clDialog);
  961.   KeyPreview := True;
  962.   PixelsPerInch := 96;
  963.   Position := poScreenCenter;
  964.   OnKeyPress := FormKeyPress;
  965.   Items[0] := NewItem('&Copy', scCtrl + vk_Insert, False, True, CopyItemClick, 0, '');
  966.   Items[1] := NewItem('&Paste', scShift + vk_Insert, False, True, PasteItemClick, 0, '');
  967.   FPasteItem := Items[1];
  968.   Popup := NewPopupMenu(Self, 'PopupMenu', paLeft, True, Items);
  969.   Popup.OnPopup := PopupMenuPopup;
  970.   { MainPanel }
  971.   FMainPanel := TPanel.Create(Self);
  972.   with FMainPanel do begin
  973.     Align := alClient;
  974.     Parent := Self;
  975.     BevelOuter := bvLowered;
  976.     ParentColor := True;
  977.     PopupMenu := Popup;
  978.   end;
  979.   { DisplayPanel }
  980.   FDisplayPanel := TPanel.Create(Self);
  981.   with FDisplayPanel do begin
  982.     SetBounds(6, 6, 230, 23);
  983.     Parent := FMainPanel;
  984.     BevelOuter := bvLowered;
  985.     Color := clWindow;
  986.     Ctl3D := False;
  987.   end;
  988.   Control := TPanel.Create(Self);
  989.   with TPanel(Control) do begin
  990.     SetBounds(1, 1, 228, 21);
  991.     Align := alClient;
  992.     Parent := FDisplayPanel;
  993.     BevelOuter := bvNone;
  994.     BorderStyle := bsSingle;
  995.     Ctl3D := False;
  996.     ParentColor := True;
  997.     ParentCtl3D := False;
  998.   end;
  999.   FDisplayLabel := TLabel.Create(Self);
  1000.   with FDisplayLabel do begin
  1001.     AutoSize := False;
  1002.     Alignment := taRightJustify;
  1003.     SetBounds(5, 2, 217, 15);
  1004.     Parent := TPanel(Control);
  1005.     Caption := '0';
  1006.   end;
  1007.   { CalcPanel }
  1008.   FCalcPanel := TCalculatorPanel.CreateLayout(Self, clDialog);
  1009.   with TCalculatorPanel(FCalcPanel) do begin
  1010.     Align := alBottom;
  1011.     Parent := FMainPanel;
  1012.     OnOkClick := Self.OkClick;
  1013.     OnCancelClick := Self.CancelClick;
  1014.     OnCalcKey := Self.CalcKey;
  1015.     OnDisplayChange := Self.DisplayChange;
  1016.     FControl := FDisplayLabel;
  1017.   end;
  1018. end;
  1019.  
  1020. procedure TRxCalculatorForm.CMCtl3DChanged(var Message: TMessage);
  1021. const
  1022.   Ctl3DBevel: array[Boolean] of TPanelBevel = (bvNone, bvLowered);
  1023. begin
  1024.   inherited;
  1025.   if FDisplayPanel <> nil then FDisplayPanel.BevelOuter := Ctl3DBevel[Ctl3D];
  1026.   if FMainPanel <> nil then FMainPanel.BevelOuter := Ctl3DBevel[Ctl3D];
  1027. end;
  1028.  
  1029. procedure TrxCalculatorForm.FormKeyPress(Sender: TObject; var Key: Char);
  1030. begin
  1031.   TCalculatorPanel(FCalcPanel).CalcKeyPress(Sender, Key);
  1032. end;
  1033.  
  1034. procedure TRxCalculatorForm.CopyItemClick(Sender: TObject);
  1035. begin
  1036.   TCalculatorPanel(FCalcPanel).Copy;
  1037. end;
  1038.  
  1039. procedure TRxCalculatorForm.PasteItemClick(Sender: TObject);
  1040. begin
  1041.   TCalculatorPanel(FCalcPanel).Paste;
  1042. end;
  1043.  
  1044. procedure TRxCalculatorForm.OkClick(Sender: TObject);
  1045. begin
  1046.   ModalResult := mrOk;
  1047. end;
  1048.  
  1049. procedure TRxCalculatorForm.CancelClick(Sender: TObject);
  1050. begin
  1051.   ModalResult := mrCancel;
  1052. end;
  1053.  
  1054. procedure TRxCalculatorForm.CalcKey(Sender: TObject; var Key: Char);
  1055. begin
  1056.   if (Owner <> nil) and (Owner is TRxCalculator) then
  1057.     TRxCalculator(Owner).CalcKey(Key);
  1058. end;
  1059.  
  1060. procedure TRxCalculatorForm.DisplayChange(Sender: TObject);
  1061. begin
  1062.   if (Owner <> nil) and (Owner is TRxCalculator) then
  1063.     TRxCalculator(Owner).DisplayChange;
  1064. end;
  1065.  
  1066. procedure TRxCalculatorForm.PopupMenuPopup(Sender: TObject);
  1067. begin
  1068.   FPasteItem.Enabled := Clipboard.HasFormat(CF_TEXT);
  1069. end;
  1070.  
  1071. end.
  1072.